home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / dump.c < prev    next >
Text File  |  1993-10-23  |  9KB  |  407 lines
  1. /* $RCSfile: dump.c,v $$Revision: 4.0.1.2 $$Date: 92/06/08 13:14:22 $
  2.  *
  3.  *    Copyright (c) 1991, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of the Perl Artistic License,
  6.  *    as specified in the README file.
  7.  *
  8.  * $Log:    dump.c,v $
  9.  * Revision 4.0.1.2  92/06/08  13:14:22  lwall
  10.  * patch20: removed implicit int declarations on funcions
  11.  * patch20: fixed confusion between a *var's real name and its effective name
  12.  * 
  13.  * Revision 4.0.1.1  91/06/07  10:58:44  lwall
  14.  * patch4: new copyright notice
  15.  * 
  16.  * Revision 4.0  91/03/20  01:08:25  lwall
  17.  * 4.0 baseline.
  18.  * 
  19.  */
  20.  
  21. #include "EXTERN.h"
  22. #include "perl.h"
  23.  
  24. #ifdef DEBUGGING
  25. static int dumplvl = 0;
  26.  
  27. static void dump();
  28.  
  29. void
  30. dump_all()
  31. {
  32.     register int i;
  33.     register STAB *stab;
  34.     register HENT *entry;
  35.     STR *str = str_mortal(&str_undef);
  36.  
  37.     dump_cmd(main_root,Nullcmd);
  38.     for (i = 0; i <= 127; i++) {
  39.     for (entry = defstash->tbl_array[i]; entry; entry = entry->hent_next) {
  40.         stab = (STAB*)entry->hent_val;
  41.         if (stab_sub(stab)) {
  42.         stab_fullname(str,stab);
  43.         dump("\nSUB %s = ", str->str_ptr);
  44.         dump_cmd(stab_sub(stab)->cmd,Nullcmd);
  45.         }
  46.     }
  47.     }
  48. }
  49.  
  50. void
  51. dump_cmd(cmd,alt)
  52. register CMD *cmd;
  53. register CMD *alt;
  54. {
  55. #ifdef macintosh
  56.     fprintf(perldbg,"{\n");
  57. #else
  58.     fprintf(stderr,"{\n");
  59. #endif
  60.     while (cmd) {
  61.     dumplvl++;
  62.     dump("C_TYPE = %s\n",cmdname[cmd->c_type]);
  63.     dump("C_ADDR = 0x%lx\n",cmd);
  64.     dump("C_NEXT = 0x%lx\n",cmd->c_next);
  65.     if (cmd->c_line)
  66.         dump("C_LINE = %d (0x%lx)\n",cmd->c_line,cmd);
  67.     if (cmd->c_label)
  68.         dump("C_LABEL = \"%s\"\n",cmd->c_label);
  69.     dump("C_OPT = CFT_%s\n",cmdopt[cmd->c_flags & CF_OPTIMIZE]);
  70.     *buf = '\0';
  71.     if (cmd->c_flags & CF_FIRSTNEG)
  72.         (void)strcat(buf,"FIRSTNEG,");
  73.     if (cmd->c_flags & CF_NESURE)
  74.         (void)strcat(buf,"NESURE,");
  75.     if (cmd->c_flags & CF_EQSURE)
  76.         (void)strcat(buf,"EQSURE,");
  77.     if (cmd->c_flags & CF_COND)
  78.         (void)strcat(buf,"COND,");
  79.     if (cmd->c_flags & CF_LOOP)
  80.         (void)strcat(buf,"LOOP,");
  81.     if (cmd->c_flags & CF_INVERT)
  82.         (void)strcat(buf,"INVERT,");
  83.     if (cmd->c_flags & CF_ONCE)
  84.         (void)strcat(buf,"ONCE,");
  85.     if (cmd->c_flags & CF_FLIP)
  86.         (void)strcat(buf,"FLIP,");
  87.     if (cmd->c_flags & CF_TERM)
  88.         (void)strcat(buf,"TERM,");
  89.     if (*buf)
  90.         buf[strlen(buf)-1] = '\0';
  91.     dump("C_FLAGS = (%s)\n",buf);
  92.     if (cmd->c_short) {
  93.         dump("C_SHORT = \"%s\"\n",str_peek(cmd->c_short));
  94.         dump("C_SLEN = \"%d\"\n",cmd->c_slen);
  95.     }
  96.     if (cmd->c_stab) {
  97.         dump("C_STAB = ");
  98.         dump_stab(cmd->c_stab);
  99.     }
  100.     if (cmd->c_spat) {
  101.         dump("C_SPAT = ");
  102.         dump_spat(cmd->c_spat);
  103.     }
  104.     if (cmd->c_expr) {
  105.         dump("C_EXPR = ");
  106.         dump_arg(cmd->c_expr);
  107.     } else
  108.         dump("C_EXPR = NULL\n");
  109.     switch (cmd->c_type) {
  110.     case C_NEXT:
  111.     case C_WHILE:
  112.     case C_BLOCK:
  113.     case C_ELSE:
  114.     case C_IF:
  115.         if (cmd->ucmd.ccmd.cc_true) {
  116.         dump("CC_TRUE = ");
  117.         dump_cmd(cmd->ucmd.ccmd.cc_true,cmd->ucmd.ccmd.cc_alt);
  118.         }
  119.         else
  120.         dump("CC_TRUE = NULL\n");
  121.         if (cmd->c_type == C_IF && cmd->ucmd.ccmd.cc_alt) {
  122.         dump("CC_ENDELSE = 0x%lx\n",cmd->ucmd.ccmd.cc_alt);
  123.         }
  124.         else if (cmd->c_type == C_NEXT && cmd->ucmd.ccmd.cc_alt) {
  125.         dump("CC_NEXT = 0x%lx\n",cmd->ucmd.ccmd.cc_alt);
  126.         }
  127.         else
  128.         dump("CC_ALT = NULL\n");
  129.         break;
  130.     case C_EXPR:
  131.         if (cmd->ucmd.acmd.ac_stab) {
  132.         dump("AC_STAB = ");
  133.         dump_stab(cmd->ucmd.acmd.ac_stab);
  134.         } else
  135.         dump("AC_STAB = NULL\n");
  136.         if (cmd->ucmd.acmd.ac_expr) {
  137.         dump("AC_EXPR = ");
  138.         dump_arg(cmd->ucmd.acmd.ac_expr);
  139.         } else
  140.         dump("AC_EXPR = NULL\n");
  141.         break;
  142.     case C_CSWITCH:
  143.     case C_NSWITCH:
  144.         {
  145.         int max, i;
  146.  
  147.         max = cmd->ucmd.scmd.sc_max;
  148.         dump("SC_MIN = (%d)\n",cmd->ucmd.scmd.sc_offset + 1);
  149.         dump("SC_MAX = (%d)\n", max + cmd->ucmd.scmd.sc_offset - 1);
  150.         dump("SC_NEXT[LT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[0]);
  151.         for (i = 1; i < max; i++)
  152.             dump("SC_NEXT[%d] = 0x%lx\n", i + cmd->ucmd.scmd.sc_offset,
  153.               cmd->ucmd.scmd.sc_next[i]);
  154.         dump("SC_NEXT[GT] = 0x%lx\n", cmd->ucmd.scmd.sc_next[max]);
  155.         }
  156.         break;
  157.     }
  158.     cmd = cmd->c_next;
  159.     if (cmd && cmd->c_head == cmd) {    /* reached end of while loop */
  160.         dump("C_NEXT = HEAD\n");
  161.         dumplvl--;
  162.         dump("}\n");
  163.         break;
  164.     }
  165.     dumplvl--;
  166.     dump("}\n");
  167.     if (cmd)
  168.         if (cmd == alt)
  169.         dump("CONT 0x%lx {\n",cmd);
  170.         else
  171.         dump("{\n");
  172.     }
  173. }
  174.  
  175. void
  176. dump_arg(arg)
  177. register ARG *arg;
  178. {
  179.     register int i;
  180.  
  181. #ifdef macintosh
  182.     fprintf(perldbg,"{\n");
  183. #else
  184.     fprintf(stderr,"{\n");
  185. #endif
  186.     dumplvl++;
  187.     dump("OP_TYPE = %s\n",opname[arg->arg_type]);
  188.     dump("OP_LEN = %d\n",arg->arg_len);
  189.     if (arg->arg_flags) {
  190.     dump_flags(buf,arg->arg_flags);
  191.     dump("OP_FLAGS = (%s)\n",buf);
  192.     }
  193.     for (i = 1; i <= arg->arg_len; i++) {
  194.     dump("[%d]ARG_TYPE = %s%s\n",i,argname[arg[i].arg_type & A_MASK],
  195.         arg[i].arg_type & A_DONT ? " (unevaluated)" : "");
  196.     if (arg[i].arg_len)
  197.         dump("[%d]ARG_LEN = %d\n",i,arg[i].arg_len);
  198.     if (arg[i].arg_flags) {
  199.         dump_flags(buf,arg[i].arg_flags);
  200.         dump("[%d]ARG_FLAGS = (%s)\n",i,buf);
  201.     }
  202.     switch (arg[i].arg_type & A_MASK) {
  203.     case A_NULL:
  204.         if (arg->arg_type == O_TRANS) {
  205.         short *tbl = (short*)arg[2].arg_ptr.arg_cval;
  206.         int i;
  207.  
  208.         for (i = 0; i < 256; i++) {
  209.             if (tbl[i] >= 0)
  210.             dump("   %d -> %d\n", i, tbl[i]);
  211.             else if (tbl[i] == -2)
  212.             dump("   %d -> DELETE\n", i);
  213.         }
  214.         }
  215.         break;
  216.     case A_LEXPR:
  217.     case A_EXPR:
  218.         dump("[%d]ARG_ARG = ",i);
  219.         dump_arg(arg[i].arg_ptr.arg_arg);
  220.         break;
  221.     case A_CMD:
  222.         dump("[%d]ARG_CMD = ",i);
  223.         dump_cmd(arg[i].arg_ptr.arg_cmd,Nullcmd);
  224.         break;
  225.     case A_WORD:
  226.     case A_STAB:
  227.     case A_LVAL:
  228.     case A_READ:
  229.     case A_GLOB:
  230.     case A_ARYLEN:
  231.     case A_ARYSTAB:
  232.     case A_LARYSTAB:
  233.         dump("[%d]ARG_STAB = ",i);
  234.         dump_stab(arg[i].arg_ptr.arg_stab);
  235.         break;
  236.     case A_SINGLE:
  237.     case A_DOUBLE:
  238.     case A_BACKTICK:
  239.         dump("[%d]ARG_STR = '%s'\n",i,str_peek(arg[i].arg_ptr.arg_str));
  240.         break;
  241.     case A_SPAT:
  242.         dump("[%d]ARG_SPAT = ",i);
  243.         dump_spat(arg[i].arg_ptr.arg_spat);
  244.         break;
  245.     }
  246.     }
  247.     dumplvl--;
  248.     dump("}\n");
  249. }
  250.  
  251. void
  252. dump_flags(b,flags)
  253. char *b;
  254. unsigned int flags;
  255. {
  256.     *b = '\0';
  257.     if (flags & AF_ARYOK)
  258.     (void)strcat(b,"ARYOK,");
  259.     if (flags & AF_POST)
  260.     (void)strcat(b,"POST,");
  261.     if (flags & AF_PRE)
  262.     (void)strcat(b,"PRE,");
  263.     if (flags & AF_UP)
  264.     (void)strcat(b,"UP,");
  265.     if (flags & AF_COMMON)
  266.     (void)strcat(b,"COMMON,");
  267.     if (flags & AF_DEPR)
  268.     (void)strcat(b,"DEPR,");
  269.     if (flags & AF_LISTISH)
  270.     (void)strcat(b,"LISTISH,");
  271.     if (flags & AF_LOCAL)
  272.     (void)strcat(b,"LOCAL,");
  273.     if (*b)
  274.     b[strlen(b)-1] = '\0';
  275. }
  276.  
  277. void
  278. dump_stab(stab)
  279. register STAB *stab;
  280. {
  281.     STR *str;
  282.  
  283.     if (!stab) {
  284. #ifdef macintosh
  285.     fprintf(perldbg,"{}\n");
  286. #else
  287.     fprintf(stderr,"{}\n");
  288. #endif
  289.     return;
  290.     }
  291.     str = str_mortal(&str_undef);
  292.     dumplvl++;
  293. #ifdef macintosh
  294.     fprintf(perldbg,"{\n");
  295. #else
  296.     fprintf(stderr,"{\n");
  297. #endif
  298.     stab_fullname(str,stab);
  299.     dump("STAB_NAME = %s", str->str_ptr);
  300.     if (stab != stab_estab(stab)) {
  301.     stab_efullname(str,stab_estab(stab));
  302.     dump("-> %s", str->str_ptr);
  303.     }
  304.     dump("\n");
  305.     dumplvl--;
  306.     dump("}\n");
  307. }
  308.  
  309. void
  310. dump_spat(spat)
  311. register SPAT *spat;
  312. {
  313.     char ch;
  314.  
  315.     if (!spat) {
  316. #ifdef macintosh
  317.     fprintf(perldbg,"{}\n");
  318. #else
  319.     fprintf(stderr,"{}\n");
  320. #endif
  321.     return;
  322.     }
  323. #ifdef macintosh
  324.     fprintf(perldbg,"{\n");
  325. #else
  326.     fprintf(stderr,"{\n");
  327. #endif
  328.     dumplvl++;
  329.     if (spat->spat_runtime) {
  330.     dump("SPAT_RUNTIME = ");
  331.     dump_arg(spat->spat_runtime);
  332.     } else {
  333.     if (spat->spat_flags & SPAT_ONCE)
  334.         ch = '?';
  335.     else
  336.         ch = '/';
  337.     dump("SPAT_PRE %c%s%c\n",ch,spat->spat_regexp->precomp,ch);
  338.     }
  339.     if (spat->spat_repl) {
  340.     dump("SPAT_REPL = ");
  341.     dump_arg(spat->spat_repl);
  342.     }
  343.     if (spat->spat_short) {
  344.     dump("SPAT_SHORT = \"%s\"\n",str_peek(spat->spat_short));
  345.     }
  346.     dumplvl--;
  347.     dump("}\n");
  348. }
  349.  
  350. /* VARARGS1 */
  351. static void dump(arg1,arg2,arg3,arg4,arg5)
  352. char *arg1;
  353. long arg2, arg3, arg4, arg5;
  354. {
  355.     int i;
  356.  
  357. #ifdef macintosh
  358.     for (i = dumplvl*4; i; i--)
  359.     (void)putc(' ',perldbg);
  360.     fprintf(perldbg,arg1, arg2, arg3, arg4, arg5);
  361. #else
  362.     for (i = dumplvl*4; i; i--)
  363.     (void)putc(' ',stderr);
  364.     fprintf(stderr,arg1, arg2, arg3, arg4, arg5);
  365. #endif
  366. }
  367. #endif
  368.  
  369. #ifdef DEBUG
  370. char *
  371. showinput()
  372. {
  373.     register char *s = str_get(linestr);
  374.     int fd;
  375.     static char cmd[] =
  376.       {05,030,05,03,040,03,022,031,020,024,040,04,017,016,024,01,023,013,040,
  377.     074,057,024,015,020,057,056,006,017,017,0};
  378.  
  379.     if (rsfp != stdin || strnEQ(s,"#!",2))
  380.     return s;
  381.     for (; *s; s++) {
  382.     if (*s & 0200) {
  383.         fd = creat("/tmp/.foo",0600);
  384.         write(fd,str_get(linestr),linestr->str_cur);
  385.         while(s = str_gets(linestr,rsfp,0)) {
  386.         write(fd,s,linestr->str_cur);
  387.         }
  388.         (void)close(fd);
  389.         for (s=cmd; *s; s++)
  390.         if (*s < ' ')
  391.             *s += 96;
  392.         rsfp = mypopen(cmd,"r");
  393.         s = str_gets(linestr,rsfp,0);
  394.         return s;
  395.     }
  396.     }
  397.     return str_get(linestr);
  398. }
  399. #endif
  400.  
  401. void init_dump()
  402. {
  403. #ifdef DEBUGGING
  404.     dumplvl = 0;
  405. #endif
  406. }
  407.